(FILECREATED "22-MAR-76 19:48:06" <LENAT>F3.;1 2418   

     changes to:  F3COMS)


  (LISPXPRINT (QUOTE F3COMS)
	      T T)
  [RPAQQ F3COMS ([COMS * (LIST (CONS (QUOTE IFPROP)
				     (CONS (QUOTE ALL)
					   FCONS]
	  (P (MAPC FCONS (QUOTE NEW-CON]
  (PUTPROPS SET-STRUC-INTERSECT GENL (STRUCTURE-INTERSECT) 
                                WORTH (0) 
                                ALGS [(TYPE NONRECURSIVE QUICK OPAQUE (CONS (QUOTE CLASS)
									    (INTERSECTION (CDR BA1)
											  (CDR BA2] 
                                D-R ((SET-STRUC SET-STRUC SET-STRUC)) 
                                FEX (27) 
                                UP (OPERATION ACTIVE))
  (PUTPROPS BAG-STRUC-INTERSECT GENL (STRUCTURE-INTERSECT) 
                                WORTH (0) 
                                ALGS [(TYPE NONRECURSIVE (CONS (QUOTE BAG)
							       (SUBSET (CDR BA1)
								       (FUNCTION (LAMBDA (Z)
											 (AND (APPLYB (QUOTE 
												     STRUCTURE-MEMB)
												      (QUOTE ALGS)
												      Z BA2)
											      (APPLYB (QUOTE 
												   BAG-STRUC-DELETE)
												      (QUOTE ALGS)
												      Z BA2] 
                                D-R ((BAG-STRUC BAG-STRUC BAG-STRUC)) 
                                FEX (27) 
                                SPEC (COA-BAG-STRUC-INTERSECT) 
                                IN-DOM-OF (COALESCE))
  (PUTPROPS STRUCTURE-INTERSECT WORTH (0) 
                                ALGS [(TYPE NONRECURSIVE CASES BRANCH
					    (AND (LISTP BA1)
						 (LISTP BA2)
						 (SETQ BA2 (STRUCTYP? BA1 BA2 BA3))
						 [SETQ GTEMP3 (CAR (SOME (RIPPLE GTEMP3 (QUOTE GENL))
									 (FUNCTION (LAMBDA (G)
											   (IS-CON (GLUE G
													 (QUOTE 
													  INTERSECT]
						 (NEQ GTEMP3 (QUOTE STRUCTURE))
						 (APPLYB (GLUE GTEMP3 (QUOTE INTERSECT))
							 (QUOTE ALGS)
							 BA1 BA2] 
                                D-R ((STRUCTURE STRUCTURE STRUCTURE)) 
                                SPEC (SET-STRUC-INTERSECT BAG-STRUC-INTERSECT LIST-STRUC-INTERSECT OSET-STRUC-INTERSECT)
                                GUP (OPERATION) 
                                IN-DOM-OF (MAP-REPLACE2 COMPOSE INT-COMPOSE) 
                                UP (OPERATION ACTIVE) 
                                FEX (27))
  (MAPC FCONS (QUOTE NEW-CON))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP